home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / modclock.bas < prev    next >
BASIC Source File  |  1985-06-03  |  14KB  |  425 lines
  1. 10  ' MODIFIED BY DWIGHT ILLK to AM/PM format. 7/22/84
  2. 11  ' AND TO SUPRESS LEADING 0's IN HOUR AND DAY.
  3. 12  ' FOR COLOR DISPLAYS, CHANGE VALUES IN THE "COLOR" STATEMENTS.
  4. 20  ' F1 Toggles Tic-toc
  5. 30  ' F2 Toggles Chimes
  6. 40  ' SPACEBAR Returns you to DOS
  7. 50 DEFINT A-Z
  8. 60 KEY OFF:CLS
  9. 70 ODD = 0
  10. 80 Q15$ = "MbMLP14O4EO4CDO3G"
  11. 90 Q30$ = "MbMLP14O3GO4DEC"
  12. 100 CHIME = 0
  13. 110 TIK$ = "Y":CHIMEON$ = "Y"
  14. 120 LOCATE ,,0
  15. 130 'COLOR 15,9,2
  16. 140 COLOR 7:CLS
  17. 150 'COLOR 12
  18. 160 LOCATE 2,19:PRINT "M I K E    S U L L I V A N ' S     I B M  P C "
  19. 170 LOCATE 4,19:PRINT "     MODIFIED  DIGITAL  CLOCK   1 . 1 0  "
  20. 180 COLOR 23
  21. 190 GOSUB 3580
  22. 200 DIM BLANK$(7),ONE$(7),TWO$(7),THR$(7),FOU$(7),FIV$(7)
  23. 210 DIM SIX$(7),SEV$(7),EIG$(7),NIN$(7),ZER$(7),TEMP$(7)
  24. 220 XH1=11:XH2=11:XM1=11:XM2=12:XS1=11:XS2=11
  25. 230 FOR I1=1 TO 7:BLANK$(I1)="        ":NEXT I1
  26. 240 COL$(1)="  "
  27. 250 COL$(2)="  "
  28. 260 COL$(3)=STRING$(2,CHR$(219))
  29. 270 COL$(4)="  "
  30. 280 COL$(5)=STRING$(2,CHR$(219))
  31. 290 COL$(6)="  "
  32. 300 COL$(7)="  "
  33. 310 ONE$(1)="  "+STRING$(3,CHR$(219))+"   "
  34. 320 ONE$(2)="   "+CHR$(219)+CHR$(219)+"   "
  35. 330 ONE$(3)="   "+CHR$(219)+CHR$(219)+"   "
  36. 340 ONE$(4)="   "+CHR$(219)+CHR$(219)+"   "
  37. 350 ONE$(5)="   "+CHR$(219)+CHR$(219)+"   "
  38. 360 ONE$(6)="   "+CHR$(219)+CHR$(219)+"   "
  39. 370 ONE$(7)=" "+STRING$(6,CHR$(219))+" "
  40. 380 TWO$(1)=STRING$(8,CHR$(219))
  41. 390 TWO$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  42. 400 TWO$(3)="      "+CHR$(219)+CHR$(219)
  43. 410 TWO$(4)=STRING$(8,CHR$(219))
  44. 420 TWO$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  45. 430 TWO$(5)=CHR$(219)+CHR$(219)+"      "
  46. 440 TWO$(7)=STRING$(8,CHR$(219))
  47. 450 THR$(1)=STRING$(8,CHR$(219))
  48. 460 THR$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  49. 470 THR$(3)="      "+CHR$(219)+CHR$(219)
  50. 480 THR$(4)="   "+STRING$(5,CHR$(219))
  51. 490 THR$(5)="      "+CHR$(219)+CHR$(219)
  52. 500 THR$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  53. 510 THR$(7)=STRING$(8,CHR$(219))
  54. 520 FOU$(1)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  55. 530 FOU$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  56. 540 FOU$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  57. 550 FOU$(4)=STRING$(8,CHR$(219))
  58. 560 FOU$(6)="      "+CHR$(219)+CHR$(219)
  59. 570 FOU$(5)="      "+CHR$(219)+CHR$(219)
  60. 580 FOU$(7)="      "+CHR$(219)+CHR$(219)
  61. 590 FIV$(1)=STRING$(8,CHR$(219))
  62. 600 FIV$(2)=CHR$(219)+CHR$(219)+"      "
  63. 610 FIV$(3)=CHR$(219)+CHR$(219)+"      "
  64. 620 FIV$(4)=STRING$(8,CHR$(219))
  65. 630 FIV$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  66. 640 FIV$(5)="      "+CHR$(219)+CHR$(219)
  67. 650 FIV$(7)=STRING$(8,CHR$(219))
  68. 660 SIX$(1)=STRING$(8,CHR$(219))
  69. 670 SIX$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  70. 680 SIX$(3)=CHR$(219)+CHR$(219)+"      "
  71. 690 SIX$(4)=STRING$(8,CHR$(219))
  72. 700 SIX$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  73. 710 SIX$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  74. 720 SIX$(7)=STRING$(8,CHR$(219))
  75. 730 SEV$(1)=STRING$(8,CHR$(219))
  76. 740 SEV$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  77. 750 SEV$(3)="      "+CHR$(219)+CHR$(219)
  78. 760 SEV$(4)="      "+CHR$(219)+CHR$(219)
  79. 770 SEV$(5)="      "+CHR$(219)+CHR$(219)
  80. 780 SEV$(6)="      "+CHR$(219)+CHR$(219)
  81. 790 SEV$(7)="      "+CHR$(219)+CHR$(219)
  82. 800 EIG$(1)=STRING$(8,CHR$(219))
  83. 810 EIG$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  84. 820 EIG$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  85. 830 EIG$(4)=STRING$(8,CHR$(219))
  86. 840 EIG$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  87. 850 EIG$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  88. 860 EIG$(7)=STRING$(8,CHR$(219))
  89. 870 NIN$(1)=STRING$(8,CHR$(219))
  90. 880 NIN$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  91. 890 NIN$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  92. 900 NIN$(4)=CHR$(219)+STRING$(7,CHR$(219))
  93. 910 NIN$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  94. 920 NIN$(5)="      "+CHR$(219)+CHR$(219)
  95. 930 NIN$(7)=STRING$(8,CHR$(219))
  96. 940 ZER$(1)=STRING$(8,CHR$(219))
  97. 950 ZER$(2)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  98. 960 ZER$(3)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  99. 970 ZER$(4)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  100. 980 ZER$(5)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  101. 990 ZER$(6)=CHR$(219)+CHR$(219)+"    "+CHR$(219)+CHR$(219)
  102. 1000 ZER$(7)=CHR$(219)+STRING$(7,CHR$(219))
  103. 1010 ATIME$ = MID$(TIME$,1,2)
  104. 1020 IF VAL(ATIME$)<=12 THEN PM$="A M"
  105. 1030 IF VAL(ATIME$)=12 THEN PM$="P M"
  106. 1040 IF VAL(ATIME$)<=12 GOTO 1060
  107. 1050 ATIME$ = STR$(VAL(ATIME$)-12):PM$="P M"
  108. 1060 LOCATE 16,2,0
  109. 1070 PRINT PM$
  110. 1080 IF LEN(ATIME$)<3 THEN ATIME$ = " "+ATIME$
  111. 1090 H1=VAL(MID$(ATIME$,2,1))
  112. 1100 H2=VAL(MID$(ATIME$,3,1))
  113. 1110 IF H1=0 AND H2=0 THEN H1=1:H2=2
  114. 1120 M1=VAL(MID$(TIME$,4,1))
  115. 1130 M2=VAL(MID$(TIME$,5,1))
  116. 1140 S1=VAL(MID$(TIME$,7,1))
  117. 1150 S2=VAL(MID$(TIME$,8,1))
  118. 1160 XDA$=MID$(DATE$,4,2)
  119. 1170 KEY(1) ON:ON KEY(1) GOSUB  3980
  120. 1180 KEY(2) ON:ON KEY(2) GOSUB  4010
  121. 1190 Z$=INKEY$:IF Z$=" " THEN CLS:SYSTEM
  122. 1200 MIN = VAL(MID$(TIME$,4,2))
  123. 1210 HOUR = VAL(MID$(ATIME$,2,2))
  124. 1220 IF HOUR = 0 THEN HOUR = 12:GOSUB 3580
  125. 1230 IF CHIME = 1 AND MIN = 0 THEN GOSUB 4070
  126. 1240 IF CHIME = 1 AND MIN = 15 THEN GOSUB 4070
  127. 1250 IF CHIME = 1 AND MIN = 30 THEN GOSUB 4070
  128. 1260 IF CHIME = 1 AND MIN = 45 THEN GOSUB 4070
  129. 1270 IF(MIN=14)OR(MIN=29)OR(MIN=44)OR(MIN=59)OR(MIN=16)OR(MIN=31)OR(MIN=46)OR(MIN=1)THEN CHIME=1
  130. 1280 IF S2=XS2 THEN 1010
  131. 1290 GOSUB  4030
  132. 1300 IF H1=0 THEN 1310 ELSE 1350
  133. 1310 IF H1=XH1 THEN 1630 ELSE XH1=H1
  134. 1320 FOR I=1 TO 7
  135. 1330 TEMP$(I)=BLANK$(I):NEXT I
  136. 1340 GOSUB 3280:GOTO 1630
  137. 1350 IF H1=XH1 THEN 1630 ELSE XH1=H1
  138. 1360 ON H1 GOTO 1370,1400,1430,1460,1490,1520,1550,1580,1610
  139. 1370 FOR I=1 TO 7
  140. 1380 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3280
  141. 1390 GOTO 1630
  142. 1400 FOR I=1 TO 7
  143. 1410 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3280
  144. 1420 GOTO 1630
  145. 1430 FOR I=1 TO 7
  146. 1440 TEMP$(I)=THR$(I):NEXT I:GOSUB 3280
  147. 1450 GOTO 1630
  148. 1460 FOR I=1 TO 7
  149. 1470 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3280
  150. 1480 GOTO 1630
  151. 1490 FOR I=1 TO 7
  152. 1500 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3280
  153. 1510 GOTO 1630
  154. 1520 FOR I=1 TO 7
  155. 1530 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3280
  156. 1540 GOTO 1630
  157. 1550 FOR I=1 TO 7
  158. 1560 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3280
  159. 1570 GOTO 1630
  160. 1580 FOR I=1 TO 7
  161. 1590 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3280
  162. 1600 GOTO 1630
  163. 1610 FOR I=1 TO 7
  164. 1620 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3280
  165. 1630 IF H2=0 THEN 1640 ELSE 1680
  166. 1640 IF H2=XH2 THEN 1970 ELSE XH2=H2
  167. 1650 FOR I=1 TO 7
  168. 1660 TEMP$(I)=ZER$(I):NEXT I
  169. 1670 GOSUB 3320:GOTO 1970
  170. 1680 IF H2=XH2 THEN 1970 ELSE XH2=H2
  171. 1690 ON H2 GOTO 1700,1730,1760,1790,1820,1850,1880,1910,1940
  172. 1700 FOR I=1 TO 7
  173. 1710 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3320
  174. 1720 GOTO 1970
  175. 1730 FOR I=1 TO 7
  176. 1740 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3320
  177. 1750 GOTO 1970
  178. 1760 FOR I=1 TO 7
  179. 1770 TEMP$(I)=THR$(I):NEXT I:GOSUB 3320
  180. 1780 GOTO 1970
  181. 1790 FOR I=1 TO 7
  182. 1800 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3320
  183. 1810 GOTO 1970
  184. 1820 FOR I=1 TO 7
  185. 1830 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3320
  186. 1840 GOTO 1970
  187. 1850 FOR I=1 TO 7
  188. 1860 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3320
  189. 1870 GOTO 1970
  190. 1880 FOR I=1 TO 7
  191. 1890 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3320
  192. 1900 GOTO 1970
  193. 1910 FOR I=1 TO 7
  194. 1920 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3320
  195. 1930 GOTO 1970
  196. 1940 FOR I=1 TO 7
  197. 1950 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3320
  198. 1960 GOTO 3270
  199. 1970 IF M1=0 THEN 1980 ELSE 2020
  200. 1980 IF M1=XM1 THEN 2300 ELSE XM1=M1
  201. 1990 FOR I=1 TO 7
  202. 2000 TEMP$(I)=ZER$(I):NEXT I
  203. 2010 GOSUB 3390:GOTO 2300
  204. 2020 IF M1=XM1 THEN 2300 ELSE XM1=M1
  205. 2030 ON M1 GOTO 2040,2070,2100,2130,2160,2190,2220,2250,2280
  206. 2040 FOR I=1 TO 7
  207. 2050 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3390
  208. 2060 GOTO 2300
  209. 2070 FOR I=1 TO 7
  210. 2080 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3390
  211. 2090 GOTO 2300
  212. 2100 FOR I=1 TO 7
  213. 2110 TEMP$(I)=THR$(I):NEXT I:GOSUB 3390
  214. 2120 GOTO 2300
  215. 2130 FOR I=1 TO 7
  216. 2140 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3390
  217. 2150 GOTO 2300
  218. 2160 FOR I=1 TO 7
  219. 2170 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3390
  220. 2180 GOTO 2300
  221. 2190 FOR I=1 TO 7
  222. 2200 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3390
  223. 2210 GOTO 2300
  224. 2220 FOR I=1 TO 7
  225. 2230 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3390
  226. 2240 GOTO 2300
  227. 2250 FOR I=1 TO 7
  228. 2260 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3390
  229. 2270 GOTO 2300
  230. 2280 FOR I=1 TO 7
  231. 2290 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3390
  232. 2300 IF M2=0 THEN 2310 ELSE 2350
  233. 2310 IF M2=XM2 THEN 2630 ELSE XM2=M2
  234. 2320 FOR I=1 TO 7
  235. 2330 TEMP$(I)=ZER$(I):NEXT I
  236. 2340 GOSUB 3430:GOTO 2630
  237. 2350 IF M2=XM2 THEN 2630 ELSE XM2=M2
  238. 2360 ON M2 GOTO 2370,2400,2430,2460,2490,2520,2550,2580,2610
  239. 2370 FOR I=1 TO 7
  240. 2380 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3430
  241. 2390 GOTO 2630
  242. 2400 FOR I=1 TO 7
  243. 2410 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3430
  244. 2420 GOTO 2630
  245. 2430 FOR I=1 TO 7
  246. 2440 TEMP$(I)=THR$(I):NEXT I:GOSUB 3430
  247. 2450 GOTO 2630
  248. 2460 FOR I=1 TO 7
  249. 2470 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3430
  250. 2480 GOTO 2630
  251. 2490 FOR I=1 TO 7
  252. 2500 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3430
  253. 2510 GOTO 2630
  254. 2520 FOR I=1 TO 7
  255. 2530 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3430
  256. 2540 GOTO 2630
  257. 2550 FOR I=1 TO 7
  258. 2560 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3430
  259. 2570 GOTO 2630
  260. 2580 FOR I=1 TO 7
  261. 2590 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3430
  262. 2600 GOTO 2630
  263. 2610 FOR I=1 TO 7
  264. 2620 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3430
  265. 2630 IF S1=0 THEN 2640 ELSE 2680
  266. 2640 IF S1=XS1 THEN 2960 ELSE XS1=S1
  267. 2650 FOR I=1 TO 7
  268. 2660 TEMP$(I)=ZER$(I):NEXT I
  269. 2670 GOSUB 3500:GOTO 2960
  270. 2680 IF S1=XS1 THEN 2960 ELSE XS1=S1
  271. 2690 ON S1 GOTO 2700,2730,2760,2790,2820,2850,2880,2910,2940
  272. 2700 FOR I=1 TO 7
  273. 2710 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3500
  274. 2720 GOTO 2960
  275. 2730 FOR I=1 TO 7
  276. 2740 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3500
  277. 2750 GOTO 2960
  278. 2760 FOR I=1 TO 7
  279. 2770 TEMP$(I)=THR$(I):NEXT I:GOSUB 3500
  280. 2780 GOTO 2960
  281. 2790 FOR I=1 TO 7
  282. 2800 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3500
  283. 2810 GOTO 2960
  284. 2820 FOR I=1 TO 7
  285. 2830 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3500
  286. 2840 GOTO 2960
  287. 2850 FOR I=1 TO 7
  288. 2860 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3500
  289. 2870 GOTO 2960
  290. 2880 FOR I=1 TO 7
  291. 2890 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3500
  292. 2900 GOTO 2960
  293. 2910 FOR I=1 TO 7
  294. 2920 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3500
  295. 2930 GOTO 2960
  296. 2940 FOR I=1 TO 7
  297. 2950 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3500
  298. 2960 IF S2=0 THEN 2970 ELSE 3000
  299. 2970 FOR I=1 TO 7
  300. 2980 TEMP$(I)=ZER$(I):NEXT I
  301. 2990 GOSUB 3540:GOTO 3270
  302. 3000 XS2=S2:ON S2 GOTO 3010,3040,3070,3100,3130,3160,3190,3220,3250
  303. 3010 FOR I=1 TO 7
  304. 3020 TEMP$(I)=ONE$(I):NEXT I:GOSUB 3540
  305. 3030 GOTO 3270
  306. 3040 FOR I=1 TO 7
  307. 3050 TEMP$(I)=TWO$(I):NEXT I:GOSUB 3540
  308. 3060 GOTO 3270
  309. 3070 FOR I=1 TO 7
  310. 3080 TEMP$(I)=THR$(I):NEXT I:GOSUB 3540
  311. 3090 GOTO 3270
  312. 3100 FOR I=1 TO 7
  313. 3110 TEMP$(I)=FOU$(I):NEXT I:GOSUB 3540
  314. 3120 GOTO 3270
  315. 3130 FOR I=1 TO 7
  316. 3140 TEMP$(I)=FIV$(I):NEXT I:GOSUB 3540
  317. 3150 GOTO 3270
  318. 3160 FOR I=1 TO 7
  319. 3170 TEMP$(I)=SIX$(I):NEXT I:GOSUB 3540
  320. 3180 GOTO 3270
  321. 3190 FOR I=1 TO 7
  322. 3200 TEMP$(I)=SEV$(I):NEXT I:GOSUB 3540
  323. 3210 GOTO 3270
  324. 3220 FOR I=1 TO 7
  325. 3230 TEMP$(I)=EIG$(I):NEXT I:GOSUB 3540
  326. 3240 GOTO 3270
  327. 3250 FOR I=1 TO 7
  328. 3260 TEMP$(I)=NIN$(I):NEXT I:GOSUB 3540
  329. 3270 XS2=S2:GOTO 1010
  330. 3280 FOR I=1 TO 7
  331. 3290 LOCATE 9+I,5:PRINT TEMP$(I)
  332. 3300 NEXT I
  333. 3310 RETURN
  334. 3320 FOR I=1 TO 7
  335. 3330 LOCATE 9+I,14:PRINT TEMP$(I)
  336. 3340 NEXT I
  337. 3350 FOR I=1 TO 7
  338. 3360 LOCATE 9+I,26:PRINT COL$(I)
  339. 3370 NEXT I
  340. 3380 RETURN
  341. 3390 FOR I=1 TO 7
  342. 3400 LOCATE 9+I,32:PRINT TEMP$(I)
  343. 3410 NEXT I
  344. 3420 RETURN
  345. 3430 FOR I=1 TO 7
  346. 3440 LOCATE 9+I,42:PRINT TEMP$(I)
  347. 3450 NEXT I
  348. 3460 FOR I=1 TO 7
  349. 3470 LOCATE 9+I,54:PRINT COL$(I)
  350. 3480 NEXT I
  351. 3490 RETURN
  352. 3500 FOR I=1 TO 7
  353. 3510 LOCATE 9+I,60:PRINT TEMP$(I)
  354. 3520 NEXT I
  355. 3530 RETURN
  356. 3540 FOR I=1 TO 7
  357. 3550 LOCATE 9+I,70:PRINT TEMP$(I)
  358. 3560 NEXT I
  359. 3570 RETURN
  360. 3580 MO$=MID$(DATE$,1,2)
  361. 3590 DA$=MID$(DATE$,4,2):DA%=VAL(DA$)
  362. 3600 YR$=MID$(DATE$,9,2)
  363. 3610 YR4$=MID$(DATE$,7,4)
  364. 3620 MO=VAL(MO$)
  365. 3630 YR=VAL(YR$)
  366. 3640 YR4=VAL(YR4$)
  367. 3650 ON MO GOTO 3660,3670,3680,3690,3700,3710,3720,3730,3740,3750,3760,3770
  368. 3660 MO$="JANUARY":GOTO 3780
  369. 3670 MO$="FEBRUARY":GOTO 3780
  370. 3680 MO$="MARCH":GOTO 3780
  371. 3690 MO$="APRIL":GOTO 3780
  372. 3700 MO$="MAY":GOTO 3780
  373. 3710 MO$="JUNE":GOTO 3780
  374. 3720 MO$="JULY":GOTO 3780
  375. 3730 MO$="AUGUST":GOTO 3780
  376. 3740 MO$="SEPTEMBER":GOTO 3780
  377. 3750 MO$="OCTOBER":GOTO 3780
  378. 3760 MO$="NOVEMBER":GOTO 3780
  379. 3770 MO$="DECEMBER":GOTO 3780
  380. 3780 YEAR%=YR4
  381. 3790 MONTH%=MO
  382. 3800 DAY%=VAL(DA$)
  383. 3810 IF MONTH%=1 OR MONTH%=2 THEN 3820 ELSE 3840
  384. 3820 YEAR%=YEAR%-1
  385. 3830 MONTH%=MONTH%+12
  386. 3840 DOW.K%=DAY%+YEAR%+MONTH%*2+YEAR%\4+YEAR%\400+(MONTH%+1)*3\5+2-YEAR%\100
  387. 3850 DOW%=DOW.K% MOD 7
  388. 3860 IF DOW%=0 OR DOW%=1 THEN DOW%=DOW%+7
  389. 3870 DOW%=DOW%-1
  390. 3880 ON DOW% GOTO 3890,3900,3910,3920,3930,3940,3950
  391. 3890 DOW$="MONDAY":GOTO 3960
  392. 3900 DOW$="TUESDAY":GOTO 3960
  393. 3910 DOW$="WEDNESDAY":GOTO 3960
  394. 3920 DOW$="THURSDAY":GOTO 3960
  395. 3930 DOW$="FRIDAY":GOTO 3960
  396. 3940 DOW$="SATURDAY":GOTO 3960
  397. 3950 DOW$="SUNDAY":GOTO 3960
  398. 3960 LOCATE 22,25:COLOR 7:PRINT DOW$;", ";MO$;" ";DA%;", ";YR4$;"     "
  399. 3965 COLOR 15
  400. 3970 RETURN
  401. 3980 IF TIK$ = "Y" THEN TIK$ = "N":RETURN
  402. 3990 IF TIK$ = "N" THEN TIK$ = "Y":RETURN
  403. 4000 RETURN
  404. 4010 IF CHIMEON$ = "Y" THEN CHIMEON$ = "N":RETURN
  405. 4020 IF CHIMEON$ = "N" THEN CHIMEON$ = "Y":RETURN
  406. 4030 IF TICKOFF < 0 THEN TICKOFF = TICKOFF + 1:RETURN
  407. 4040 IF TIK$ = "N" THEN RETURN
  408. 4050 IF ODD = 1 THEN SOUND  98,.25:ODD = 0:RETURN
  409. 4060 SOUND 38,.25:ODD = 1:RETURN
  410. 4070 IF CHIMEON$ = "N" THEN RETURN
  411. 4080 CHIME = 0
  412. 4090 ODD = 0
  413. 4100 IF MIN = 15 THEN PLAY Q15$:TICKOFF = -2:RETURN
  414. 4110 IF MIN = 30 THEN PLAY Q15$+Q30$:TICKOFF = -5:RETURN
  415. 4120 IF MIN = 45 THEN PLAY Q15$+Q30$+Q15$:TICKOFF = -7:RETURN
  416. 4130 IF MIN = 0 THEN PLAY Q15$+Q30$+Q15$+Q30$:TICKOFF = -9 + -1*HOUR
  417. 4140 PLAY "mbP2"
  418. 4150 HOUR = VAL(LEFT$(TIME$,2))
  419. 4160 IF HOUR>12 THEN HOUR = HOUR - 12
  420. 4170 IF HOUR = 0 THEN HOUR = 12
  421. 4180 FOR II = 1 TO HOUR
  422. 4190 PLAY"MBO3CN0"
  423. 4200 NEXT II
  424. 4210 RETURN
  425.